perm filename NEW.FAI[XX,LCS]3 blob
sn#225199 filedate 1976-07-09 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 TITLE BMSTF 0300 SUBROUTINE BMSTF
C00024 ENDMK
C⊗;
TITLE BMSTF ;0300 SUBROUTINE BMSTF
ENTRY BMSTF
EXTERNAL STAFF,RHORZ,AMOD,NOZERO,LINES,BMS,MAKNUM
EXTERNAL .COMM.,ALF,POSI,STF,MIN,BM,PLTR
BMSTF: 0 ;00400 IMPLICIT INTEGER(A-Q,S-Z)
;00500 REAL DIS,DISX,HGT,POS,CENTR,STFF,HGT1
;00600 COMMON/STF/RSTFAC(-3/4),RSTJ2/MIN/MINI,RMINI
;00700 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/BM/RA,RC,RJY
;00800 COMMON/POSI/STFF(-3/4),JJ2,POS/PLTR/PLT,RHT,DIS
;00900 COMMON/ALF/QQ(3),RST7,RST18,R3Q,JY,RD,RX,RW,RJX,RJ,L,K,
;01000 1 RJA,YY,DISX,HGT,RZ,INP(53)
;01100 EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R5,RJQ(3))
;01200 1,(R6,RJQ(4)),(J7,JQ(5)),(J8,JQ(6)),(J9,JQ(7)),(J10,JQ(8))
;01300 1,(J11,JQ(9)),(J6,JQ(4)),(R9,RJQ(7)),(R8,RJQ(6)),(R3,RJQ(1
;01400 1 ,(R7,RJQ(5)),(R4,RJQ(2)),(R9,RJQ(7)),(R10,RJQ(8)),(RX3,R
;01500 DATA R14/14.54/,RTF/3.0/,RHGT/48.0/,R2HGT/96.0/,RBM/.83/
;01600 C RDBR IS SPACER FOR DBL BAR.
; 01710 IF(JA.NE.8)GO TO 100
MOVEI 02,10
CAME 02,.COMM.+1
JRST BS100
; 01720 CALL STAFF
JSA 16,STAFF
JRA 16,(16) ;1730 RETURN
; 02000 C TO COMPENSATE FOR NOTE #3 COMING AT POS=0
; 02200 R3Q=R3
BS100: MOVE 13,.COMM.+4
MOVE 10,.COMM.+=31 ; 10 IS J10, 13 IS R3Q
; 02400 C NEXT IS FOR BEAMS
; 02500 RMINI=RSTJ2
MOVE 12,STF+=8
MOVEM 12,MIN+1
; 02600 RX=2.7*RSTJ2*5.96
FMPR 12,[16.092] ; 12 IS RX
MOVE 5,.COMM.+=10 ; SAVE R9 IN 5
MOVE 6,.COMM.+=28 ; 6 IS J7
MOVE 14,.COMM.+=29 ; J8
;; MOVE .COMM.+5 ;IF(R4.GE.80)R4=R4-100
;; CAMGE [-20.0] ;CHECK FOR -95, ETC.
;; FADR [100.0]
;; CAMGE [80.0] ;CATCHES SOME NEG. MINIS (I.E.<-100)
;; JRST .+3
;; FSBR [100.0]
;; MOVEM .COMM.+5 ;**** ALL DONE IN CENTX NOW (LOOP.FAI)****
JSA 16,RHORZ ; 02800 R6=RHORZ(R6)
JUMP .COMM.+7
MOVEM 00,.COMM.+7
MOVSI 2,204500 ; (10.0) IF(R8.NE.0)GO TO 204
SKIPN .COMM.+=9
CAMG 2,.COMM.+=11
JRST BS204 ; IF(R10.GE.10)GO TO 204
JUMPL 6,BS204 ; 03100 IF(J7)GO TO 204
JUMPN 5,BS1 ; 03200 IF(R9.NE.0)GO TO 1
; R8=0 AND R9=NUM -- PUTS NUMBER OUTSIDE BEAM(FOR TRIPLET
BS204: JUMPE 5,.+4 ;03400 204 IF(R9.NE.0)R9=RHORZ(R9)
JSA 16,RHORZ
JUMP .COMM.+=10
MOVEM 5 ; 5 IS R9
JUMPL 6,BS201 ; IF(J7)GO TO 201
BS200: CAIGE 10,=10 ; 200 IF(J10.LT.10)GO TO 91
JRST BS91
; 03700 C NEXT FOR INNER, PARTIAL BEAMS
JSA 16,RHORZ ; 03800 R8=RHORZ(R8)
JUMP .COMM.+=9
MOVEM 00,.COMM.+=9
JSA 16,AMOD ; 03900 R10=AMOD(R10,10.)
JUMP .COMM.+=11
JUMP [10.0]
MOVEM 00,.COMM.+=11
MOVE 02,10 ;04000 GO TO(2,3,4),.COMM.+=31/10
IDIVI 02,12
CAIN 2,3
JRST BS4
CAIN 2,2
JRST BS3 ;4100 2 RH=R9+RX
BS2: MOVE 02,12
FADR 02,5
MOVEM 02,RH#
; 04200 GO TO 1
JRST BS1
; 04300 3 R8=R9-RX
BS3: MOVN 02,12
FADR 02,5
MOVEM 02,.COMM.+=9;10=SHRT PARTIAL LFT↑RT., 20=RT.↑LFT, 30=TO POS IN P8
; 04500 4 RH=R8
BS4: MOVE 02,.COMM.+=9
MOVEM 02,RH
; 04600 C LEFT INNER POS.
; 04700 GO TO 1
JRST BS1
; 04800 201 J7=-J7
BS201: MOVNS 6
;4900 C P8=WIDTH OF TREM. P9=0(SANS OTHER BEAMS) OR =POS.3, P10=D
; 05000 CALL NOZERO(R10)
JSA 16,NOZERO
JUMP .COMM.+=11
; ALWAYS AT LEAST 1 IN DISPLACEMENT
; 05200 J10=30
MOVEI 10,36
; TO ACTIVATE PARTIAL BEAM SECTION
; 05400 IF(J9.NE.0)GO TO 202
MOVE 02,.COMM.+=30
JUMPN 02,BS202
; 05500 C NEXT FOR TREM. WITHOUT OTHER BEAMS.
; 05600 RH=-1
MOVSI 02,576400
CAIL 6,24 ;5700 IF(J7.GE.20)RH=-RH
MOVNS 2
MOVEM 02,RH
; 06000 R5=R4+RH
FADR 02,.COMM.+5
MOVEM 02,.COMM.+6
; 06100 R9=R3
MOVE 05,.COMM.+4
; 06200 R6=R3+22.*RMINI
MOVSI 02,205540
FMPR 02,MIN+1
FADR 02,.COMM.+4
MOVEM 02,.COMM.+7
; 06300 202 IF(R8.EQ.0)R8=4.
BS202: MOVE 12,.COMM.+=9
JUMPN 12,.+3
MOVSI 12,203400
MOVEM 12,.COMM.+=9
; 06400 RX=R8*RMINI*2.98
FMPR 12,MIN+1
FMPR 12,[2.98]
; 06500 RH=R9+RX
MOVE 02,12
FADR 02,5
MOVEM 02,RH
; 06600 R9=R9-RX
MOVN 02,12
FADRM 02,5
; 06700 GO TO 1
JRST BS1
BS91: JUMPE 14,BS1 ; 91 IF(J8.EQ.0)GO TO 1
JUMPG 14,BS92 ; IF(J8.GT.0)GO TO 92
; FOR J8=-(10+DN) OR -(20+DN) R9=R3+RX
MOVE 5,.COMM.+4
FADR 5,12 ; IF(J8.LE.-20)R9=R6-RX
CAMLE 14,[-=20]
JRST .+3
MOVN 5,12
FADR 5,.COMM.+7
; 07400 192 J8=-J8
BS192: MOVNS 14
BS92: JUMPN 10,.+3 ;92 IF(J10.EQ.0)J10=MOD(J8,10)
MOVE 7,14
IDIVI 7,=10 ; IF(J10.EQ.0)J10=1
SKIPN 10
MOVEI 10,1
FLTR 2,10 ;MOVE 2,10 ; R10=J10
; TLC 2,232000
; FADR 2,2
MOVEM 2,.COMM.+=11 ;IF P8 NEG, P9 IS AUTOMATIC, ALSO P10 IF NEEDED.
; 08000 1 IF(IABS(J4).LT.100)GO TO 97
BS1: MOVM .COMM.+=25
CAIGE 00,144
JRST BS97
; 08100 RMINI=.6*RSTJ2
MOVE 02,[0.6]
FMPR 02,STF+=8
MOVEM 02,MIN+1
; 08200 R5=AMOD(R5,100.0)
JSA 16,AMOD
JUMP .COMM.+6
JUMP [100.0]
MOVEM 00,.COMM.+6 ; SPACE BETWEEN BEAMS
; 08400 97 RJ=RMINI*11.
BS97: MOVSI 2,204540
FMPR 2,MIN+1
MOVEM 2,ALF+=11
MOVSI 206600 ;MOVE [48.0] ;RW=RMINI*RHGT
FMPR MIN+1
MOVEM ALF+=9 ; DIST. UP OR DOWN FROM NOTE HEAD.
FMPR 2,.COMM.+=11 ;RJA=R10*RJ
MOVEM 2,ALF+=14 ; DISPLACEMENT
MOVEM 5,.COMM.+=10 ; RD=R9
MOVEM 5,ALF+7 ; POSITION 3
FSBR 2,ALF+=9
FADR 02,.COMM.+2 ; RJX=CENTR-RW+RJA
MOVEM 02,ALF+=10 ; FINAL HEIGHT OF LEFT SIDE
; 09300 C NEG R7=TREMOLO
; 09400 RX=MOD(J7,10)
MOVE 11,6
IDIVI 11,=10
FLTR 12,12 ;TLC 12,232000
;FADR 12,12
MOVEI 1,(6) ; PUT J7 IN 1 FOR NOW
SUBI 6,=20 ;9500 JJ2=J7-20
; 09600 RA=R6
MOVE 02,.COMM.+7
MOVEM 02,BM ; HORIZANTAL DIST.
; RJY=R5*RST7+POS-RST18-RW+RJA
MOVSI 3,203700 ; 7.0
FMPR 03,.COMM.+6
FSBR 3,[18.0]
FMPR 3,STF+=8
FADR 3,ALF+=14
FADR 3,POSI+=9
FSBR 3,ALF+=9
MOVEM 3,BM+2 ; VERTICAL POS OF RIGHT SIDE.
; 10000 RW=R14*RMINI
MOVE 4,[14.54]
FMPR 4,MIN+1
MOVEM 4,ALF+=9
; 10100 RY=1.
MOVSI 02,201400
MOVEM 02,RY#
CAIL 1,24 ;200 IF(J7.GE.20)GO TO 98
JRST BS98 ; JUMP IF STEMS ARE DOWN
; 10400 RY=-RY
MOVNS 00,RY
; 10500 C FOR THICKENING INCR.
ADDI 6,=10 ;0600 JJ2=J7-10
; 10700 RJ=-RJ
MOVNS 00,ALF+=11
; 10800 RJA=RMINI*R2HGT-2.*RJA
MOVE 02,[96.0]
FMPR 02,MIN+1
MOVE 03,ALF+=14
FSC 03,1
FSBR 02,3
MOVEM 02,ALF+=14
; 10900 RJX=RJX+RJA
FADRM 02,ALF+=10
; 11000 RJY=RJY+RJA
FADRM 02,BM+2
; 11100 R3Q=R3Q+RW
FADRM 4,13 ; POSITION 1
; 11300 RA=RA+RW
FADRM 4,BM ; POSITION 2
; 11500 RD=RD+RW
FADRM 4,ALF+7
; 11700 RH=RH+RW
FADRM 4,RH
; 11800 98 RSTJ2=RSTJ2*RBM
BS98: MOVE 02,[0.83]
FMPRM 02,STF+=8
; RBM BRINGS LINES OF BEAMS CLOSER TOGETHER. (=.83)
MOVEM 6,POSI+=8 ; JJ2 12000 93 IF(JJ2.GT.RX)GO TO 94
FLTR 6,6 ;TLC 6,232000
; FADR 6,6
CAMLE 6,12
JRST BS94
CAIL 10,=10 ;2100 IF(J10.GE.10)GO TO 7
JRST BS7
; 12200 C**********************
JUMPE 14,BS94 ; IF(J8.EQ.0)GO TO 94
; 12400 R3=RW
; 12500 IF(J9.EQ.0)GO TO 292
MOVE 02,.COMM.+=30
JUMPE 02,BS292
CAIL 14,24 ; IF(J8.GE.20)GO TO 193
JRST BS193
; 12700 293 RX=R3Q-RD
BS293: MOVE 12,13
FSBR 12,ALF+7
; 12800 GO TO 194
JRST BS194
; 12900 7 RHX=RH-R3Q
; 13000 R3=RD-R3Q
BS7: MOVN 4,13
FADR 4,ALF+7
; 13100 GO TO 292
JRST BS292
; 13200 193 RX=RD-RA
BS193: MOVE 12,ALF+7
FSBR 12,BM
; 13300 194 R3=ABS(RX)
BS194: MOVM 4,12
; 13400 292 DISX=ABS(R3Q-RA)
BS292: MOVE 02,13
FSBR 02,BM
MOVMM 02,ALF+=16
; 13500 HGT=RJX-RJY
MOVE 3,ALF+=10
FSBR 3,BM+2
MOVEM 3,HGT#
CAIGE 10,=10 ;3600 IF(J10.GE.10)HGT1=HGT*RHX/DISX
JRST BS10
MOVN 1,13
FADR 1,RH
FMPR 1,3
FDVR 1,2 ; 1 HAS -HGT1
; 13800 R3=R3/DISX
BS10: FDVR 4,ALF+=16
MOVEM 4,.COMM.+4
; 13900 195 HGT=HGT*R3
FMPRB 4,HGT
; 14000 196 L=J8/10
; 14100 J8=0
SETZM .COMM.+=29
CAIL 10,=10 ;14200 IF(J10.GE.10)GO TO 8
JRST BS8
IDIVI 14,=10 ;( L=J8/10)
CAIN 14,1 ; IF(L.EQ.1)GO TO 95
JRST BS95
; C BEAM LFT=1, RT=2 (PARAM 8=10 OR 20)
; 14600 R3Q=RD
MOVE 13,ALF+7
; 14700 RJX=RJY+HGT
FADR 04,BM+2 ; 4 WAS HGT
MOVEM 04,ALF+=10
; 14800 GO TO 94
JRST BS94
; 15000 8 R3Q=RH
BS8: MOVE 13,RH
; 15200 RJY=RJX-HGT
MOVE 02,ALF+=10
FSBR 02,HGT
MOVEM 02,BM+2
FADRM 1,ALF+=10 ;15300 RJX=RJX-HGT1
; 15400 GO TO 94
JRST BS94-2
; 15500 95 RA=RD
; 15600 RJY=RJX-HGT
BS95: MOVE 02,ALF+=10
FSBR 02,HGT
MOVEM 02,BM+2
MOVE 02,ALF+7
MOVEM 02,BM
BS94: MOVEM 13,ALF+5 ;(R3Q)15700 94 L=7.*RMINI
MOVSI 02,203700
FMPR 02,MIN+1
KIFIX 0,2 ;JSA 16,IFIX
; JUMP 2
MOVEM 00,ALF+=12
; 15800 930 RC=0
BS930: SETZM BM+1
; C MINI LINES HAVE .2 SMALLER BEAMS. MAYBE CHANGE THIS??
; 16000 CALL LINES(R3Q,RJX,3)
JSA 16,LINES
JUMP ALF+5
JUMP ALF+=10
JUMP [3]
; 16100 DO 941 K=1,L
MOVEI 15,1
; 16200 CALL BMS
BS12: JSA 16,BMS
; 16300 IF(PLT.GE.0)GO TO 940
MOVE 02,PLTR
JUMPGE 02,BS940
; 16400 RC=RC+RY
MOVE 02,RY
FADRM 02,BM+1 ; FOR THICKENING.
; 16600 CALL BMS
JSA 16,BMS
MOVE 1,ALF+5 ; CALL EXCH(RA,ALF+5)
EXCH 1,BM
MOVEM 1,ALF+5
MOVE 1,ALF+=10
EXCH 1,BM+2 ; 941 CALL EXCH(RJY,RJX)
MOVEM 1,ALF+=10
CAMGE 15,ALF+=12
AOJA 15,BS12
; 16900 CALL BMS
JSA 16,BMS ; DRAWS 5 LINES FOR BEAMS.
; 17100 940 JJ2=JJ2-1
BS940: SOSG POSI+=8
; 17200 IF(JJ2.LE.0)GO TO 942
JRST BS942 ; IF P7=10 OR 20 ONE BEAM WILL APPEAR.
; 17400 RJY=RJY+RJ
MOVE 02,ALF+=11
FADRM 02,BM+2
; 17500 RJX=RJX+RJ
FADRM 02,ALF+=10
; 17600 GO TO 930
JRST BS930
; 17800 942 IF(R8.NE.0)RETURN
BS942: SKIPN .COMM.+=9
SKIPN .COMM.+=10
JRA 16,(16)
; 17900 IF(R9.EQ.0)RETURN
; 18000 IF(R10.GE.30)RETURN
MOVSI 02,205740
CAMG 02,.COMM.+=11
JRA 16,(16) ; C FOR NUMBERS OUTSIDE BEAMS
; 18200 RSTJ2=RMINI
MOVE 02,MIN+1
MOVEM 02,STF+=8
; 18300 RD=-10.
MOVN 3,[10.0]
; 18400 IF(R7.LT.20)RD=8.3
MOVSI 02,205500
CAMLE 02,.COMM.+=8
MOVE 3,[8.3]
; 18500 943 J3=R3Q+(RA-R3Q)/2.
BS943: MOVN 02,ALF+5
FADR 02,BM
FSC 02,777777
FADR 02,ALF+5
KIFIX 0,2 ;JSA 16,IFIX
; JUMP 2
MOVEM 00,.COMM.+=24
; 18600 R6=1.
MOVSI 02,201400
MOVEM 02,.COMM.+7
; 18900 R7=1
MOVEM 02,.COMM.+=8 ; C ITALICS
; 18800 R4=R4+(R5-R4)/2.+RD
MOVE 02,.COMM.+6
FSBR 02,.COMM.+5
FSC 02,777777
FADR 2,3
FADRM 02,.COMM.+5 ↔ SETZM .COMM.+=12 ; R11=0
; 19100 CALL MAKNUM(R9)
JSA 16,MAKNUM
JUMP .COMM.+=10
JRA 16,(16) ; 19300 END
END